Adults, 7-point scale
# make wideframe df
d1b_prep <- d1b %>%
select(subid, age, character, capacity, responseNum) %>%
mutate(age = as.numeric(as.character(age))) %>%
spread(capacity, responseNum) %>%
arrange(age) %>%
remove_rownames() %>%
column_to_rownames("subid")
# limit to complete cases for tsne
d1b_all_complete <- d1b_prep[complete.cases(d1b_prep),]
# make LDA-friendly df
d1b_LDA <- d1b_all_complete %>%
rownames_to_column("subid") %>%
select(-age, -character) %>%
gather(capacity, response, -subid) %>%
mutate(response = ifelse(response > 0, 1, response)) # legit?
# mutate(response = (response * 2)) # is this legit? not counts...
d1b_LDA_keep <- d1b_LDA %>%
ungroup() %>%
group_by(subid) %>%
summarise(sum = sum(response, na.rm = T)) %>%
filter(sum != 0) %>%
mutate(subid = as.character(subid))
d1b_LDA <- d1b_LDA %>%
filter(subid %in% d1b_LDA_keep$subid) %>%
ungroup() %>%
spread(capacity, response) %>%
remove_rownames() %>%
column_to_rownames("subid")
# do LDA
d1b_LDA <- LDA(x = d1b_LDA, k = 10)
# look at terms by topic
d1b_LDA_topics <- tidy(d1b_LDA, matrix = "beta")
d1b_LDA_termorder <- d1b_LDA_topics %>%
group_by(term) %>%
top_n(1, beta) %>%
arrange(topic, desc(beta)) %>%
data.frame() %>%
rownames_to_column("order") %>%
mutate(order = as.numeric(as.character(order)))
ggplot(d1b_LDA_topics %>%
full_join(d1b_LDA_termorder %>% select(term, order)) %>%
distinct(),
aes(x = topic, y = reorder(term, desc(order)), fill = beta)) +
geom_tile() +
scale_fill_distiller(palette = "YlGn", direction = 1,
guide = guide_colorbar(title = element_blank(),
barheight = 10)) +
theme_minimal()
Joining, by = "term"

# look at topics by "document" (participant)
d1b_LDA_documents <- tidy(d1b_LDA, matrix = "gamma") %>%
rename(subid = document)
d1b_LDA_docorder <- d1b_LDA_documents %>%
group_by(subid) %>%
top_n(1, gamma) %>%
arrange(topic, desc(gamma)) %>%
data.frame() %>%
rownames_to_column("order") %>%
mutate(order = as.numeric(as.character(order))) %>%
full_join(d1b_all_complete %>%
rownames_to_column("subid") %>%
select(subid, age, character))
Joining, by = "subid"
# ggplot(d1b_LDA_documents %>%
# full_join(d1b_LDA_docorder %>% select(subid, order)),
# aes(x = topic, y = reorder(subid, desc(order)), fill = gamma)) +
# geom_tile() +
# scale_fill_distiller(palette = "RdYlBu",
# guide = guide_colorbar(title = element_blank(),
# barheight = 10)) +
# theme_minimal()
ggplot(d1b_LDA_documents %>%
full_join(d1b_LDA_docorder) %>%
filter(!is.na(character), !is.na(topic)) %>%
distinct(),
aes(x = age, y = gamma, color = factor(topic))) +
# facet_wrap(~ topic) +
facet_grid(character ~ topic) +
geom_point() +
# geom_smooth(method = "lm") +
theme_bw()
Joining, by = c("subid", "topic", "gamma")

4-10yo
# make LDA-friendly df
d_slide_LDA <- d_slide_all_complete %>%
rownames_to_column("subid") %>%
select(-age, -character) %>%
gather(capacity, response, -subid) %>%
mutate(response = ifelse(response > 0, 1, response)) # legit?
# mutate(response = (response * 2)) # is this legit? not counts...
d_slide_LDA_keep <- d_slide_LDA %>%
ungroup() %>%
group_by(subid) %>%
summarise(sum = sum(response, na.rm = T)) %>%
filter(sum != 0) %>%
mutate(subid = as.character(subid))
d_slide_LDA <- d_slide_LDA %>%
filter(subid %in% d_slide_LDA_keep$subid) %>%
ungroup() %>%
spread(capacity, response) %>%
remove_rownames() %>%
column_to_rownames("subid")
# do LDA
d_slide_LDA <- LDA(x = d_slide_LDA, k = 3)
# look at terms by topic
d_slide_LDA_topics <- tidy(d_slide_LDA, matrix = "beta")
d_slide_LDA_termorder <- d_slide_LDA_topics %>%
group_by(term) %>%
top_n(1, beta) %>%
arrange(topic, desc(beta)) %>%
data.frame() %>%
rownames_to_column("order") %>%
mutate(order = as.numeric(as.character(order)))
ggplot(d_slide_LDA_topics %>%
full_join(d_slide_LDA_termorder %>% select(term, order)) %>%
distinct(),
aes(x = topic, y = reorder(term, desc(order)), fill = beta)) +
geom_tile() +
scale_fill_distiller(palette = "YlGn", direction = 1,
guide = guide_colorbar(title = element_blank(),
barheight = 10)) +
scale_x_continuous(breaks = 1:10) +
theme_minimal()
Joining, by = "term"

# look at topics by "document" (participant)
d_slide_LDA_documents <- tidy(d_slide_LDA, matrix = "gamma") %>%
rename(subid = document)
d_slide_LDA_docorder <- d_slide_LDA_documents %>%
group_by(subid) %>%
top_n(1, gamma) %>%
arrange(topic, desc(gamma)) %>%
data.frame() %>%
rownames_to_column("order") %>%
mutate(order = as.numeric(as.character(order))) %>%
full_join(d_slide_all_complete %>%
rownames_to_column("subid") %>%
select(subid, age, character))
Joining, by = "subid"
# ggplot(d_slide_LDA_documents %>%
# full_join(d_slide_LDA_docorder %>% select(subid, order)),
# aes(x = topic, y = reorder(subid, desc(order)), fill = gamma)) +
# geom_tile() +
# scale_fill_distiller(palette = "RdYlBu",
# guide = guide_colorbar(title = element_blank(),
# barheight = 10)) +
# theme_minimal()
ggplot(d_slide_LDA_documents %>%
full_join(d_slide_LDA_docorder %>% select(subid, character, age)) %>%
filter(!is.na(character), !is.na(topic)) %>%
distinct(),
aes(x = age, y = gamma,
# color = character, fill = character)) +
color = factor(topic), fill = factor(topic))) +
# facet_grid(~ topic) +
facet_grid(character ~ topic) +
geom_point() +
geom_smooth(method = "lm") +
theme_bw()
Joining, by = "subid"

library(plotly)
plot_ly(d_slide_LDA_documents %>%
mutate(topic = recode(topic,
"1" = "topic_1",
"2" = "topic_2",
"3" = "topic_3")) %>%
spread(topic, gamma) %>%
full_join(d_slide_LDA_docorder %>%
select(subid, age, character)) %>%
filter(!is.na(character)),
x = ~topic_1, y = ~topic_2, z = ~topic_3,
color = ~age,
# color = ~character,
# size = ~age,
opacity = 0.6)
Joining, by = "subid"
No trace type specified:
Based on info supplied, a 'scatter3d' trace seems appropriate.
Read more about this trace type -> https://plot.ly/r/reference/#scatter3d
No scatter3d mode specifed:
Setting the mode to markers
Read more about this attribute -> https://plot.ly/r/reference/#scatter-mode
Ignoring 16 observationsNo trace type specified:
Based on info supplied, a 'scatter3d' trace seems appropriate.
Read more about this trace type -> https://plot.ly/r/reference/#scatter3d
No scatter3d mode specifed:
Setting the mode to markers
Read more about this attribute -> https://plot.ly/r/reference/#scatter-mode
Ignoring 16 observations